Delphi Programmer's Power Pack/Delphi Volume 1.iso/s_to_z/spidr100/setup.arv/ARRTEST.PAS

Pascal/Delphi Source File | 1996-09-15 | 9.1 KB | 364 lines

{----------------------------------------------------------------------------
|
| Library: Spider Containers for Object Pascal
|
| Module: ArrTest.Pas
|
| Description: Form for TArray test.
|
| History: Version 1.0  March 1996. Copyright (c) 1996 Michel Brazeau
|                                   Interval Software
|
|---------------------------------------------------------------------------}
unit ArrTest;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls,

  ObjArray;  { TArray }

type
  TArrayForm = class(TForm)
    AddRandomButton: TButton;
    RemoveButton: TButton;
    ClearButton: TButton;
    ShellSort: TButton;
    QuickSort: TButton;
    Load: TButton;
    BinarySearch: TButton;
    LinearSearch: TButton;
    ListBox: TListBox;
    AddButton: TButton;
    ItemCount: TLabel;
    ResizeButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RemoveButtonClick(Sender: TObject);
    procedure AddRandomButtonClick(Sender: TObject);
    procedure ClearButtonClick(Sender: TObject);
    procedure ShellSortClick(Sender: TObject);
    procedure QuickSortClick(Sender: TObject);
    procedure LoadClick(Sender: TObject);
    procedure BinarySearchClick(Sender: TObject);
    procedure LinearSearchClick(Sender: TObject);
    procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure AddButtonClick(Sender: TObject);
    procedure ResizeButtonClick(Sender: TObject);

  private
     ObjArray : TArray;

     { updates the ItemCount lable from the List.Size }
     procedure UpdateItemCount;

     { add a value to the array }
     procedure AddValue(Value : Word);

  end;

{--------------------------------------------------------------------------}

implementation

{$R *.DFM}

uses
      ObjTest,   { GetRandomNumber }
      ObjList,   { TUnorderedList }
      ObjBuckt;  { TBucket }

{--------------------------------------------------------------------------}

procedure TArrayForm.FormCreate(Sender: TObject);
begin
    ObjArray := TArray.Create(TWordBucket, CompareWordBucket, 3000, 1000);
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.FormDestroy(Sender: TObject);
begin
    ObjArray.Free;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.AddValue(Value : Word);
var
    Bucket : TWordBucket;
begin
    Bucket := TWordBucket.Create(Value);
    try
        ListBox.Items.AddObject('', nil);
        try
            ObjArray.Insert(Bucket);
        except
            ListBox.Items.Delete(ListBox.Items.Count-1);
            raise;
        end;
    except
        Bucket.Free;
        raise;
    end;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.UpdateItemCount;
begin
    ItemCount.Caption := IntToStr(ObjArray.Size);
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.AddRandomButtonClick(Sender: TObject);
var
    Bucket : TWordBucket;
begin
    AddValue(GetRandomNumber);

    ListBox.ItemIndex := ListBox.Items.Count - 1;

    UpdateItemCount;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.RemoveButtonClick(Sender: TObject);
var
    Item : LongInt;  { 0 based item index }

begin
    Item := ListBox.ItemIndex;

    if Item <= -1 then
        Exit;  { no item is selected, since ItemIndex = -1 when no item is
                 selected }

    ObjArray.Delete(Item+1);

    ListBox.Items.Delete(Item);

    { keep an item selected, convert from 1 based to 0 based }
    if ListBox.Items.Count <= Item then
        ListBox.ItemIndex := Item - 1
    else
        ListBox.ItemIndex := Item;

    UpdateItemCount;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.ClearButtonClick(Sender: TObject);
begin
    { clear the list box }
    ListBox.Clear;

    { clear the array }
    ObjArray.Clear;

    UpdateItemCount;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.ShellSortClick(Sender: TObject);
begin
    Screen.Cursor := crHourGlass;
    try
        ObjArray.ShellSort;

        ListBox.Refresh;
    finally
        Screen.Cursor := crDefault;
    end;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.QuickSortClick(Sender: TObject);
begin
    Screen.Cursor := crHourGlass;
    try
        ObjArray.QuickSort;

        ListBox.Refresh;
    finally
        Screen.Cursor := crDefault;
    end;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.LoadClick(Sender: TObject);
var
    NumberList  : TUnorderedList;

    WordBucket : TWordBucket;

    Value      : Word;

    I          : LongInt;
begin
    NumberList := TUnOrderedList.Create(TWordBucket, CompareWordBucket);
    try
        TestForm.LoadNumbersFromFile(NumberList);

        Screen.Cursor := crHourGlass;
        try
            I := 1;

            { insert all the values in NumberList }
            if NumberList.GotoFirst then
            repeat

                { give other applications processing time }
                if (I mod 500) = 0 then
                    Application.ProcessMessages;
                Inc(I);


                Value := (NumberList.CurrentObj as TWordBucket).Value;

                WordBucket := TWordBucket.Create(Value);

                AddValue(Value);

            until not NumberList.GotoNext;
        finally
            Screen.Cursor := crDefault;
        end;

    finally
        NumberList.Free;

        ListBox.ItemIndex := ListBox.Items.Count - 1;

        UpdateItemCount;
    end;

end;

{--------------------------------------------------------------------------}

procedure TArrayForm.BinarySearchClick(Sender: TObject);
const
    NumberStr : String = '0';

var
    Bucket    : TWordBucket;

    Index     : TArrayIndex;

begin
    if not InputQuery('', 'Search for: ', NumberStr) then
        Exit;

    Bucket := TWordBucket.Create(StrToInt(NumberStr));
    try
        Index := ObjArray.BinarySearch(Bucket);
        if Index <> CInvalidArrayIndex then
            MessageDlg('Value found at index ' + IntToStr(Index), mtInformation,[mbOk], 0)
        else
            MessageDlg('Value NOT found!', mtInformation,[mbOk], 0);

    finally
        Bucket.Free;
    end;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.LinearSearchClick(Sender: TObject);
const
    NumberStr : String = '0';
var
    Bucket    : TWordBucket;

    Index     : TArrayIndex;

begin
    if not InputQuery('', 'Search for: ', NumberStr) then
        Exit;

    Bucket := TWordBucket.Create(StrToInt(NumberStr));
    try
        Index := ObjArray.LinearSearch(Bucket);
        if Index <> CInvalidArrayIndex then
            MessageDlg('Value found at index ' + IntToStr(Index), mtInformation,[mbOk], 0)
        else
            MessageDlg('Value NOT found!', mtInformation,[mbOk], 0);

    finally
        Bucket.Free;
    end;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.ListBoxDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
    with (Control as TListBox).Canvas do
    begin
        FillRect(Rect);    { clear the rectangle }

        TextOut( Rect.Left + 2, Rect.Top,
                 IntToStr((ObjArray[Index+1] as TWordBucket).Value))
    end; { with }
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.FormClose( Sender: TObject;
                                var Action: TCloseAction);
begin
    Action := caFree;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.AddButtonClick(Sender: TObject);
const
    NumStr : String = '0';
begin

    if not InputQuery('', 'Value to add: ', NumStr) then
        Exit;

    AddValue(StrToInt(NumStr));

    ListBox.ItemIndex := ListBox.Items.Count - 1;

    UpdateItemCount;
end;

{--------------------------------------------------------------------------}

procedure TArrayForm.ResizeButtonClick(Sender: TObject);
const
    CapacityStr : String = '1000';
    DeltaStr    : String = '500';

begin
    if not InputQuery('', 'New Capacity: ', CapacityStr) then
        Exit;

    if not InputQuery('', 'New Delta: ', DeltaStr) then
        Exit;

    ObjArray.Capacity := StrToInt(CapacityStr);

    ObjArray.Delta    := StrToInt(DeltaStr);
end;

{--------------------------------------------------------------------------}

end.